home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MOUSE.SWG / 0020_GREAT Mouse Routines.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-09  |  6KB  |  188 lines
  1.  
  2. { Rodent unit  v1.3      OooO }  { << isn't he cute? } {   09/01/93              \/  }
  3. { Interrupt-style interface for Microsoft mouse, Turbo Pascal 6.0+}
  4.  
  5. { by Sean L. Palmer }
  6. { Released to the Public Domain }
  7.  
  8. { Please credit me if your program uses these routines! }
  9.  
  10.  
  11. unit Rodent;
  12. {$A-,B-,D-,E-,F-,G+,I-,L-,N-,O-,R-,S-,V-,X+}
  13. {make sure you alloc enough stack space in main program!} {as written, requires a 286+ and that the mouse exists}
  14.  
  15. interface
  16.  
  17. const
  18.  x :integer=0; y :integer=0; {current mouse pos}
  19.  xs:integer=0; ys:integer=0; {mickey counts}
  20.  left=1; center=2; right=4;  {button masks- (btn and left)<>0 if left button
  21.                               down}
  22.  b:boolean=false;            {button status, true if any button down} var
  23.  btn:byte absolute b;        {button status, mask with (btn and mask)<>0 to
  24.                               get a specific button}
  25.  hidden:boolean;
  26. type
  27.  pMouseHook=^tMouseHook;
  28.  tMouseHook=procedure;
  29.  
  30. {avoid calling dos, bios, and mouse routines from these if possible}
  31. function erasHook(h:tMouseHook):pMouseHook;
  32. function moveHook(h:tMouseHook):pMouseHook;
  33. function drawHook(h:tMouseHook):pMouseHook; {change out handlers}
  34. function clikHook(h:tMouseHook):pMouseHook;
  35. function liftHook(h:tMouseHook):pMouseHook;
  36.  
  37. procedure show(f:boolean);          {true=show}
  38. procedure confine(l,t,r,b:integer); {set min,max bounds}
  39. procedure moveTo(h,v:integer);
  40. procedure setSpeed(xs,ys,thr:word); {set x,y pix per 16 mickeys, double speed threshold}
  41.  
  42. implementation
  43.  
  44. {This unit should work in any mode, but you need to provide the routines
  45.  to draw and erase the cursor.}
  46. {note: reason coords are scaled *8 throughout is because mouse driver}
  47.  {stupidly messes with the values differently in different modes.}
  48.  {This is just a work-around so it won't be limited to every eighth column
  49.   or row in text modes.}
  50. {PS: be very careful using mickey counts in DI & SI in event handler.}
  51.  
  52. var
  53.  hideCount:byte absolute hidden;
  54.  
  55.  
  56. {this procedure does nothing, used to disable an event} procedure defaultMouseHook;far;assembler;asm end;
  57.  
  58. {must save previous setting of I-flag}
  59. procedure clearInts;inline($9C/$FA); {pushF;cli} procedure restoreInts;inline($9D);   {popF}
  60.  
  61. const
  62.  vDrawHook:tMouseHook=defaultMouseHook; {pre-set all hooks to do nothing}
  63.  vErasHook:tMouseHook=defaultMouseHook;
  64.  vMoveHook:tMouseHook=defaultMouseHook;
  65.  vClikHook:tMouseHook=defaultMouseHook;
  66.  vLiftHook:tMouseHook=defaultMouseHook;
  67.  
  68. {these all both set a hook to a procedure you provide, and also return
  69.  the old hook so you can later restore it} {Use something like:}
  70.  
  71. {var savedClikHook:tMouseHook;}
  72. {...}
  73. {@savedClikHook:=clikHook(myClikHook);}
  74. {...}
  75. {clikHook(savedClikHook)}
  76.  
  77. function drawHook(h:tMouseHook):pMouseHook;begin
  78.  drawHook:=@vDrawHook; clearInts; vDrawHook:=h; restoreInts;
  79.  end;
  80. function erasHook(h:tMouseHook):pMouseHook;begin
  81.  erasHook:=@vErasHook; clearInts; vErasHook:=h; restoreInts;
  82.  end;
  83. function moveHook(h:tMouseHook):pMouseHook;begin
  84.  moveHook:=@vMoveHook; clearInts; vMoveHook:=h; restoreInts;
  85.  end;
  86. function clikHook(h:tMouseHook):pMouseHook;begin
  87.  clikHook:=@vclikHook; clearInts; vClikHook:=h; restoreInts;
  88.  end;
  89. function liftHook(h:tMouseHook):pMouseHook;begin
  90.  liftHook:=@vLiftHook; clearInts; vLiftHook:=h; restoreInts;
  91.  end;
  92.  
  93. {here is the callback function for the mouse driver}
  94.  
  95. {calling regs:}
  96.  {ax:triggering event bit mask}
  97.  {bx:button status bit mask (bit 0=left,1=center,2=right)}
  98.  {cx:mouse X/bit 7 is sign for di,bit 0 always=0}
  99.  {dx:mouse Y/bit 7 is sign for si}
  100.  {di:abs mouse Delta X}
  101.  {si:abs mouse Delta Y}
  102.  
  103. {bits in event mask:}
  104.  {0:move}
  105.  {1:left btn down}
  106.  {2:left btn up}
  107.  {3,4:center btn}
  108.  {5,6:right btn}
  109.  
  110. {This code is real easy to break, be careful!} procedure doMouseHook;far;assembler;asm
  111.  push ax; mov ax,seg @DATA; mov ds,ax; pop ax;
  112.  mov xs,si; mov ys,di; {disregard di,si mickey counts}
  113.  mov btn,bl;
  114.  and cx,$3FFF; shr cx,3; and dx,$3FFF; shr dx,3; {strip hi bits}
  115.  push ax; push cx; push dx;  {save event status}
  116.  test hidden,$FF; jnz @NOERAS; call vErasHook; @NOERAS:
  117.  pop dx; mov y,dx; pop cx; mov x,cx;
  118.  call vMoveHook;  {always assume mouse has moved, disregard bit 0 of ax}
  119.  test hidden,$FF; jnz @NODRAW; call vDrawHook; @NODRAW:
  120.  pop ax; {restore event status}
  121. @CLIK: test al,00101010b; jz @LIFT; {check any button clik flag}
  122.  push ax; call vClikHook; pop ax;
  123. @LIFT: test al,01010100b; jz @EXIT; {check any button lift flag}
  124.  call vLiftHook;
  125. @EXIT:
  126.  end;
  127.  
  128. procedure show(f:boolean);begin
  129.  clearInts;
  130.  if f then begin
  131.   if hidden then begin dec(hideCount); if not hidden then vDrawHook; end;
  132.   end
  133.  else begin if not hidden then vErasHook; inc(hideCount); end;
  134.  restoreInts;
  135.  end;
  136.  
  137. Procedure confine(l,t,r,b:integer);assembler;asm
  138.  mov ax,7; mov cx,l; shl cx,3; mov dx,r; shl dx,3; int $33;
  139.  mov ax,8; mov cx,t; shl cx,3; mov dx,b; shl dx,3; int $33;
  140.  end;
  141.  
  142. procedure moveTo(h,v:integer);begin
  143.  if not hidden then vErasHook;
  144.  asm mov cx,h; mov x,cx; shl cx,3;
  145.      mov dx,v; mov y,dx; shl dx,3;
  146.      mov ax,4; int $33; end;
  147.  if not hidden then vDrawHook;
  148.  end;
  149.  
  150. procedure setSpeed(xs,ys,thr:word);assembler;asm
  151.  mov ax,$1A; mov bx,xs; shl bx,3; mov cx,ys; shl cx,3; mov dx,thr; int $33;
  152.  end;
  153.  
  154. var
  155.  oldMouseHook:pointer;
  156.  oldEventMask:word;
  157.  
  158. procedure removeMouse;begin
  159.  if not hidden then show(false);
  160.  asm les dx,oldMouseHook; mov cx,oldEventMask; mov ax,$C; int $33;end;
  161.  end;
  162.  
  163. var
  164.  mouseHook:pointer absolute 0:$33*4;
  165. const
  166.  eventMask=$7F;  {all events}
  167.  
  168. function exists:boolean;assembler;asm
  169.  xor ax,ax; mov es,ax; {get ready to check interrupt vector for nil}
  170.  mov bx,es:[$33*4]; or bx,es:[$33*4+2]; jz @X; {no}
  171.  {ax still 0} int $33; @X:  {result in al}
  172.  end;
  173.  
  174. begin
  175.  if exists then begin
  176.   setSpeed(32,64,4);    {set up a natural-feeling speed for 640x480}
  177.   moveTo(0,0); confine(0,0,0,0); {trap the little sucker}
  178.   hideCount:=1;
  179.   asm
  180.    push cs; pop es; mov dx,offset doMouseHook; {loc of callback function}
  181.    mov cx,eventMask; mov ax,$14; int $33;      {enable event callbacks}
  182.    mov oldEventMask,cx;
  183.    mov word ptr oldMouseHook,dx; mov word ptr oldMouseHook+2,es;
  184.    end;
  185.   end
  186.  else begin writeln('Need mouse.'); halt(1);end;
  187.  end.
  188.